home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.0 / stk-3 / blt-for-STk-3.0 / dd-protocol.stklos < prev    next >
Encoding:
Text File  |  1995-12-27  |  4.3 KB  |  119 lines
  1. ;;;; ----------------------------------------------------------------------
  2. ;;;;  PURPOSE:  drag&drop send routine for "XXX" data
  3. ;;;;
  4. ;;;;  Widgets that are to participate in drag&drop operations for
  5. ;;;;  "XXX" data should be registered as follows:
  6. ;;;;
  7. ;;;;      (blt_drag&drop .win 'source 'handler 'XXX 'dd-send-color)
  8. ;;;;      (blt_drag&drop .win 'target 'handler 'XXX 'my-color-handler)
  9. ;;;;
  10. ;;;;      (define (my-color-handler)
  11. ;;;;          (let ((data (hash-table-get DragDrop 'XXX ;;;;f)))
  12. ;;;;        (if data
  13. ;;;;           .
  14. ;;;;                   .  do something with $data
  15. ;;;;                  .
  16. ;;;;                )))
  17. ;;;; ORIGINAL AUTHOR:  Michael J. McLennan       Phone: (215)770-2842
  18. ;;;;                    AT&T Bell Laboratories   E-mail: aluxpo!mmc@att.com
  19. ;;;;
  20. ;;;; ----------------------------------------------------------------------
  21. ;;;;            Copyright (c) 1993  AT&T  All Rights Reserved
  22. ;;;; ======================================================================
  23.  
  24. ;;;;
  25. ;;;; rewritten for STk by Erick Gallesio [eg@unice.fr]
  26. ;;;;    Creation date:  7-Jul-1994 10:13
  27. ;;;; Last file update: 28-Dec-1995 00:33
  28.  
  29. (require "hash")
  30. (require "stklos")
  31.  
  32. (define DragDrop (make-hash-table))
  33.  
  34. (define (make-drag&drop-label win . args)
  35.   (let ((token-name (& win ".label")))
  36.     ; Use catch since label can fail (id the window has previously be created)
  37.     (catch (pack (label token-name)))
  38.     ;; Now configure it to the given arguments
  39.     (apply (string->widget token-name) 'configure args)))
  40.  
  41. (define (drag&drop . l)
  42.   (apply blt_drag&drop (map (lambda(x) (if (instance? x) (slot-ref x 'Id) x)) l)))
  43.  
  44. (define (drag&drop-configure win . args)
  45.   (let ((pc   (get-keyword :package-command args #f))
  46.     (sh   (get-keyword :source-handler  args #f))
  47.     (th   (get-keyword :target-handler  args #f)))
  48.     (when pc (drag&drop 'source win 'config :package pc))
  49.     (when sh (apply drag&drop 'source win 'handler sh))
  50.     (when th (apply drag&drop 'target win 'handler th))))
  51.  
  52. ;;;; ----------------------------------------------------------------------
  53. ;;;; (dd-send-color <interp> <ddwin> <data>)
  54. ;;;;
  55. ;;;;   INPUTS
  56. ;;;;     <interp> = interpreter for target application
  57. ;;;;      <ddwin> = pathname for target drag&drop window
  58. ;;;;       <data> = data returned from -tokencmd
  59. ;;;;
  60. ;;;;   RETURNS
  61. ;;;;     ""
  62. ;;;;
  63. ;;;;   SIDE-EFFECTS
  64. ;;;;     Sends data to remote application DragDrop(color), and then
  65. ;;;;     invokes the "color" handler for the drag&drop target.
  66. ;;;; ----------------------------------------------------------------------
  67. (define (dd-send-color interp ddwin data)
  68.   (send interp `(begin
  69.           ;; Verify it is a color
  70.           (winfo 'rgb *root* ',data)
  71.           (hash-table-put! DragDrop 'color ',data)))
  72.   (send interp `(blt_drag&drop 'target ,ddwin 'handle 'color))
  73.   "")
  74.  
  75. ;;;; ----------------------------------------------------------------------
  76. ;;;; dd-send-number <interp> <ddwin> <data>
  77. ;;;;
  78. ;;;;   INPUTS
  79. ;;;;     <interp> = interpreter for target application
  80. ;;;;      <ddwin> = pathname for target drag&drop window
  81. ;;;;       <data> = data returned from -tokencmd
  82. ;;;;
  83. ;;;;   RETURNS
  84. ;;;;     ""
  85. ;;;;
  86. ;;;;   SIDE-EFFECTS
  87. ;;;;     Sends data to remote application DragDrop(number), and then
  88. ;;;;     invokes the "number" handler for the drag&drop target.
  89. ;;;; ----------------------------------------------------------------------
  90. (define (dd-send-number interp ddwin data)
  91.   (send interp `(let ((x (if (string? ,data) (string->number ,data) ,data)))
  92.           (unless (number? x)
  93.               (error "dd-send-number: nbad number: ~S." x))
  94.           (hash-table-put! DragDrop 'number x)))
  95.   (send interp `(blt_drag&drop 'target ,ddwin 'handle 'number))
  96.   "")
  97.  
  98. ;;;; ----------------------------------------------------------------------
  99. ;;;; (dd-send-text <interp> <ddwin> <data>)
  100. ;;;;
  101. ;;;;   INPUTS
  102. ;;;;     <interp> = interpreter for target application
  103. ;;;;      <ddwin> = pathname for target drag&drop window
  104. ;;;;       <data> = data returned from -tokencmd
  105. ;;;;
  106. ;;;;   RETURNS
  107. ;;;;     ""
  108. ;;;;
  109. ;;;;   SIDE-EFFECTS
  110. ;;;;     Sends data to remote application DragDrop(text), and then
  111. ;;;;     invokes the "text" handler for the drag&drop target.
  112. ;;;; ----------------------------------------------------------------------
  113. (define (dd-send-text interp ddwin data)
  114.   (send interp `(hash-table-put! DragDrop 'text ,data))
  115.   (send interp `(blt_drag&drop 'target ,ddwin 'handle 'text))
  116.   "")
  117.  
  118. (provide "dd-protocol.stklos")
  119.